home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / AMOS3.DMS / in.adf / Instr_Conv.AMOS / Instr_Conv.amosSourceCode
Encoding:
AMOS Source Code  |  1978-10-10  |  8.2 KB  |  320 lines
  1. '--------------------------------------------------------------------------- 
  2. '                 SoundTracker to IFF instrument converter 
  3. '
  4. '                          By Francois Lionet  
  5. '
  6. '                       (c) Mandarin/Jawx 1990 
  7. '--------------------------------------------------------------------------- 
  8. '  This program allows you to transform any instrument referenced by 
  9. ' SoundTracker's preset list (version 2.3 and above), into an IFF 8SVX 
  10. ' instrument.
  11. '  It is neccessary to do this because the Sonix to AMOS converter can only
  12. ' accept single IFF samples. 
  13. '--------------------------------------------------------------------------- 
  14. Dim FR(7)
  15. FR(1)=65 : FR(2)=131 : FR(3)=262 : FR(4)=523 : FR(5)=1046 : FR(6)=2093 : FR(7)=4186
  16. '
  17. Global FR(),OCT,LSAM,ADSAM,ADRAW,FREQ,L1,L2,AD2,VOL,NAME$
  18. '
  19. ' Open an ice-cream (sorry a nice screen) with a rainbow 
  20. Screen Open 0,640,200,2,Hires : Curs Off 
  21. Palette $0,$FC7
  22. Set Rainbow 0,0,64,"","","(2,1,8)(2,-1,8)"
  23. Rainbow 0,0,35,256
  24. Channel 0 To Rainbow 0
  25. Amal 0,"L: For R0=0 To 63; Let X=R0; For R1=0 To 4; Next R1; Next R0; Jump L"
  26. Amal On 
  27. '
  28. Wind Open 2,0,20*8,80,5 : Curs Off : Scroll Off 
  29. '
  30. ' Loads preset list
  31. ALERT[">>> Loading preset list <<<"]
  32. Open In 1,"St-00:PLST" : LPLST=Lof(1) : Close 
  33. Reserve As Work 10,LPLST
  34. Bload "St-00:PLST",10
  35. LPLST=Length(10)
  36. APLST=Start(10)+$1E
  37. NED=LPLST/$1E-2
  38. ALERT[""]
  39. '
  40. ' Open window (routines taken from CONFIG.AMOS!) 
  41. Window 0
  42. LED=Min(NED,16)
  43. Reserve Zone 50 : DR_MENU
  44. Wind Open 1,24*8,8*(10-(LED+2)/2),32,LED+2,1 : Scroll Off 
  45. PY=0 : ACT=0 : Gosub ALL_PRINT
  46. '
  47. ' Test for mouse 
  48. Do 
  49.    ALERT[""] : If NAME$<>"" : ALERT["Loaded sample : "+NAME$] : End If 
  50.    Window 1
  51.    Repeat 
  52.       Z=Mouse Zone
  53.       If Z<>ACT
  54.          If ACT>0 : N=ACT : ACT=0 : Gosub ST_PRINT : End If 
  55.          If Z>0 and Z<=LED : ACT=Z : N=Z : Gosub ST_PRINT : End If 
  56.       End If 
  57.       MK=Mouse Key
  58.       If MK and Z>LED
  59.          Exit If Z=26,2
  60.          Exit If Z=23 or Z=24
  61.          If LED<>NED
  62.             If Z=25 and PY>0
  63.                Home : Vscroll 1
  64.                Dec PY : N=1 : Gosub ST_PRINT
  65.             End If 
  66.             If Z=28 and PY-LED>0
  67.                Add PY,-LED : Gosub ALL_PRINT
  68.             End If 
  69.             If Z=27 and PY+LED<NED
  70.                Locate 0,LED-1 : Vscroll 3
  71.                Inc PY : N=LED : Gosub ST_PRINT
  72.             End If 
  73.             If Z=29 and PY+LED*2<NED
  74.                Add PY,LED : Gosub ALL_PRINT
  75.             End If 
  76.          End If 
  77.          MK=0
  78.       End If 
  79.    Until MK
  80.    While Mouse Key : Wend 
  81.    '  
  82.    ' Load the sample
  83.    LD_IT:
  84.    If Z<=LED and Z<>0
  85.       ALERT["... Loading "+NM$+"..."]
  86.       LD_SAMP[NM$] : OLDNM$=NM$ : EXTRACT_NAME[NM$]
  87.       If Param
  88.          NAME$="" : ALERT[">>> Load aborted! <<<"] : Bell : Wait 50
  89.       Else 
  90.          PL_SAMP
  91.       End If 
  92.    End If 
  93.    If Z=23
  94.       If NAME$<>""
  95.          PL_SAMP
  96.       Else 
  97.          Bell : ALERT["Load a sample first!"] : Wait 50
  98.       End If 
  99.    End If 
  100.    If Z=24
  101.       If NAME$<>""
  102.          N$=PATH_OUT$+NAME$+"(IFF).Instr"
  103.          ALERT["---> Save as "+N$+"? (Y/N) <---"]
  104.          Repeat 
  105.             Repeat : A$=Upper$(Inkey$) : Until A$<>""
  106.          Until(A$="Y") or(A$="N")
  107.          If A$="N"
  108.             N$=Fsel$("*.Instr",NAME$+"(IFF).Instr","Please choose new name","or change the disc.")
  109.          End If 
  110.          If N$<>""
  111.             CONV_SAMP[N$]
  112.             If Param
  113.                ALERT[">>> Disc error! <<<"]
  114.             End If 
  115.          Else 
  116.             Bell : ALERT["Not done!"] : Wait 50
  117.          End If 
  118.       Else 
  119.          Bell : ALERT["Load a sample first!"] : Wait 50
  120.       End If 
  121.    End If 
  122.    While Mouse Key : Wend 
  123. Loop 
  124. '
  125. ' Back to basic
  126. Screen Close 0
  127. Edit 
  128. '------------------- 
  129. ' Print ALL strings  
  130. '------------------- 
  131. ALL_PRINT:
  132. For N=1 To LED
  133.    Gosub ST_PRINT
  134.    Set Zone N,X Graphic(0),Y Graphic(N-1) To X Graphic(28),Y Graphic(N-1)+8
  135. Next 
  136. Return 
  137. '------------------
  138. ' Print ONE string 
  139. '------------------
  140. ST_PRINT:
  141. Curs Off 
  142. If N=ACT
  143.    Inverse On 
  144. Else 
  145.    Inverse Off 
  146. End If 
  147. ADSAM=APLST+(PY+N)*$1E : NM$=""
  148. X=0
  149. Do 
  150.    P=Peek(ADSAM+X) : Inc X
  151.    Exit If P=0
  152.    NM$=NM$+Chr$(P)
  153. Loop 
  154. Locate 0,N-1 : Print Chr$(7); Using "###";N+PY;" : ";NM$;
  155. Return 
  156. '  
  157. Procedure LD_SAMP[N$]
  158.    On Error Goto SAM_ERR
  159.    Open In 1,N$ : LSAM=Lof(1) : Close 
  160.    Erase 5 : Reserve As Chip Work 5,LSAM+24
  161.    AD=Start(5)
  162.    A$="Samples " : Loke AD-8,Leek(Varptr(A$)) : Loke AD-4,Leek(Varptr(A$)+4)
  163.    Doke AD,1 : Add AD,2
  164.    Loke AD,6 : Add AD,4
  165.    Add AD,8
  166.    FREQ=8363 : Doke AD,FREQ : Add AD,2
  167.    Loke AD,LSAM : Add AD,4
  168.    ADRAW=AD : Bload N$,AD
  169.    L1=Deek(ADSAM+$16)*2 : L2=Deek(ADSAM+$1C)*2 : If L2=2 : L2=0 : End If 
  170.    AD2=Deek(ADSAM+$1A)*2 : VOL=Deek(ADSAM+$18)
  171.    If L1+L2>LSAM : L1=LSAM-L2 : End If 
  172.    Error 20
  173.    SAM_ERR: E=Errn : Close : Resume SAM_OUT
  174.    SAM_OUT:
  175. End Proc[E-22]
  176. Procedure PL_SAMP
  177.    ER_MENU
  178.    FREQ=8363 : OCT=4
  179.    Window 2 : Clw : Print At(1,1)+Border$(At(79,3),4);
  180.    For O=1 To 6
  181.       Print At(O*4+4,2)+Border$(Zone$("C"+Mid$(Str$(O+1),2),30+O),1);
  182.    Next O
  183.    Print At(32,2)+Border$(Zone$("Hear",37),1)
  184.    Print At(72,2)+Border$(Zone$("Quit",38),1)
  185.    For P=0 To 4
  186.       Print At(38+P,1)+Zone$("+",40+P*2);
  187.       Print At(38+P,3)+Zone$("-",41+P*2);
  188.    Next 
  189.    Do 
  190.       F$="00000" : A$=Str$(FREQ)-" "
  191.       Mid$(F$,6-Len(A$))=A$
  192.       Print At(38,2);F$
  193.       Doke Start(5)+14,FREQ
  194.       Sam Play 15,1
  195.       Do 
  196.          Print At(48,2);"Octave:";OCT
  197.          Wait 10
  198.          If MK=1 : While Mouse Key : Wend : End If 
  199.          Repeat 
  200.             Z=Mouse Zone
  201.             MK=Mouse Key
  202.             A$=Inkey$
  203.             If A$=" " : Z=30+OCT-1 : MK=1 : End If 
  204.          Until Z>=30 and MK<>0
  205.          If Z=37
  206.             Sam Play 15,1
  207.          End If 
  208.          If Z=38
  209.             Exit 2
  210.          End If 
  211.          If Z<37
  212.             Bell 1+12*(Z-30)
  213.             OCT=Z-30+1
  214.          End If 
  215.          If Z>=40
  216.             ZZ=(Z-40)/2
  217.             A$=Mid$(F$,ZZ+1,1)
  218.             If Btst(0,Z)=0
  219.                A$=Chr$(Asc(A$)+1)
  220.                If A$>"9" : A$="0" : End If 
  221.             Else 
  222.                A$=Chr$(Asc(A$)-1)
  223.                If A$<"0" : A$="9" : End If 
  224.             End If 
  225.             Mid$(F$,ZZ+1)=A$
  226.             FREQ=Val(F$)
  227.             Exit 1
  228.          End If 
  229.       Loop 
  230.    Loop 
  231.    DR_MENU
  232. End Proc
  233. Procedure CONV_SAMP[N$]
  234.    ALERT["...Saving "+N$+"..."]
  235.    On Error Goto CONV_ERR
  236.    Open Out 1,N$
  237.    Print #1,"FORM    8SVXVHDR";
  238.    OUT_NB[4,20]
  239.    OUT_NB[4,L1]
  240.    OUT_NB[4,L2]
  241.    OUT_NB[4,FREQ/FR(OCT)]
  242.    OUT_NB[2,FREQ]
  243.    OUT_NB[1,1]
  244.    OUT_NB[1,0]
  245.    OUT_NB[4,VOL*$400]
  246.    Print #1,"BODY";
  247.    OUT_NB[4,LSAM]
  248.    P1=LSAM/256 : P2=LSAM-P1*256 : A$=Space$(256)
  249.    If P1
  250.       For P=0 To P1-1
  251.          Copy ADRAW+P*256,ADRAW+P*256+256 To Varptr(A$)
  252.          Print #1,A$;
  253.       Next 
  254.    End If 
  255.    If P2
  256.       For P=0 To P2-1
  257.          A$=Chr$(Peek(ADRAW+P1*256+P))
  258.          Print #1,A$;
  259.       Next 
  260.    End If 
  261.    P=Pof(1)
  262.    If Btst(0,A) : Print #1,Chr$(0); : End If 
  263.    Pof(1)=4
  264.    OUT_NB[4,Lof(1)-12]
  265.    Error 20
  266.    '
  267.    CONV_ERR: E=Errn : Close : Resume CONV_OUT
  268.    CONV_OUT:
  269. End Proc[E-22]
  270. Procedure DR_MENU
  271.    Window 0 : X=20
  272.    ARROW[X*8+4,6*8,20,6,4,25] : ARROW[X*8+4,14*8,20,-6,4,27]
  273.    ARROW[X*8+4,3*8,10,12,4,28] : ARROW[X*8+4,17*8,10,-12,4,29]
  274.    CASE[20*8+4,10*8,12,22,4,26] : VER_TEXT["Quit",20,8]
  275.    CASE[60*8+4,10*8,12,72,4,23] : VER_TEXT["  Hear sample  ",60,2]
  276.    CASE[66*8+4,10*8,12,72,4,24] : VER_TEXT["Save IFF sample",66,2]
  277. End Proc
  278. Procedure ER_MENU
  279.    Cls 0,0,0 To 24*8,160
  280.    Cls 0,58*8,0 To 640,160
  281. End Proc
  282. Procedure OUT_NB[BITS,NB]
  283.    For N=4-BITS To 3
  284.       A$=Chr$(Peek(Varptr(NB)+N)) : Print #1,A$;
  285.    Next 
  286. End Proc
  287. Procedure ALERT[A$]
  288.    Window 2 : Clw 
  289.    Centre At(,2)+A$
  290. End Proc
  291. Procedure ARROW[X,Y,SX,SY,S,ZON]
  292.    Set Paint 0
  293.    Ink 1 : Set Paint 3
  294.    For N=0 To S-1
  295.       Polyline X-SX+N,Y+SY To X,Y-SY To X+SX-N,Y+SY
  296.    Next 
  297.    SX=Abs(SX) : SY=Abs(SY)
  298.    Set Zone ZON,X-SX,Y-SY To X+SX,Y+SY
  299. End Proc
  300. Procedure CASE[X,Y,SX,SY,S,ZON]
  301.    Set Paint 0
  302.    Ink 1 : Set Paint 3
  303.    For N=0 To S-1
  304.       Box X-SX+N,Y-SY+N To X+SX-N,Y+SY-N
  305.    Next 
  306.    Set Zone ZON,X-SX,Y-SY To X+SX,Y+SY
  307. End Proc
  308. Procedure VER_TEXT[A$,X,Y]
  309.    For N=1 To Len(A$)
  310.       Locate X,Y+N-1
  311.       Print Mid$(A$,N,1);
  312.    Next 
  313. End Proc
  314. Procedure EXTRACT_NAME[N$]
  315.    For N=Len(N$) To 1 Step -1
  316.       A$=Mid$(N$,N,1)
  317.       Exit If(A$=":") or(A$="/")
  318.    Next 
  319.    NAME$=Mid$(N$,N+1)
  320. End Proc